
###########################
### IRT with our model ###
###########################
rm(list=ls(all=TRUE)) 
load("data/sample10K.RData")
library(hIRT)

## Grouping survey questions
questions <- paste("q", 1:50, sep = "")
f1 <- c(1, 2, 3, 4, 5, 10, 12, 13, 14, 17) # political liberalism
f2 <- c(21, 25, 27, 29, 30, 37, 40) # free market
f3 <- c(32, 41, 42, 43, 46, 47, 48, 49, 50) # traditional values
f4 <- c(9, 11, 15, 16, 18, 19, 20) # nationalism
f5 <- c(24, 7, 8, 44, 45) # individual freedom
f6 <- c(23, 26, 28, 35, 39) # national interest
f7 <- c(22, 31, 33, 34, 36, 38) # social justice
FSet <- list(f1, f2, f3, f4, f5, f6, f7)

## ### Model D -- Political, nationalism / Economic / Traditionalism:
factor1 <- sort(unique(c(f1,f4,f5)))
factor2 <- sort(unique(c(f2,f6, f7)))
factor3 <- sort(unique(c(f3)))

## factor 1 
y <-d[, questions[factor1]] #political 
x <- model.matrix(~provgb+age+educ+income+gender, d)
z <- model.matrix(~provgb+age+educ+income, d)
zuobiao_m1 <- hgrm(y=y, x=x)

a1 <- length(factor1)
discrmn_a1 <- matrix(NA, nrow = a1, ncol = 4)
for (i in 1:a1){
  discrmn_a1[i,] <- as.numeric(coef_item(zuobiao_m1)[[i]][4,1:2]) * (-1)
  discrmn_a1[i,3] <- discrmn_a1[i,1]-1.96*discrmn_a1[i,2]
  discrmn_a1[i,4] <- discrmn_a1[i,1]+1.96*discrmn_a1[i,2]
}

### factor 2
y <-d[, questions[factor2]] #political 
zuobiao_m2 <- hgrm(y=y, x=x)

a2 <- length(factor2)
discrmn_a2 <- matrix(NA, nrow = a2, ncol = 4)
for (i in 1:a2){
  discrmn_a2[i,] <- as.numeric(coef_item(zuobiao_m2)[[i]][4,1:2]) * (-1)
  discrmn_a2[i,3] <- discrmn_a2[i,1]-1.96*discrmn_a2[i,2]
  discrmn_a2[i,4] <- discrmn_a2[i,1]+1.96*discrmn_a2[i,2]
}

### factor 3 
y <-d[, questions[factor3]] #political 
zuobiao_m3 <- hgrm(y=y, x=x)

a3 <- length(factor3)
discrmn_a3 <- matrix(NA, nrow = a3, ncol = 4)
for (i in 1:a3){
  discrmn_a3[i,] <- as.numeric(coef_item(zuobiao_m3)[[i]][4,1:2]) *(-1)
  discrmn_a3[i,3] <- discrmn_a3[i,1]-1.96*discrmn_a3[i,2]
  discrmn_a3[i,4] <- discrmn_a3[i,1]+1.96*discrmn_a3[i,2]
}

###
discrmn <- rbind(discrmn_a1, discrmn_a2, discrmn_a3)
discrmn <- cbind(c(factor1, factor2, factor3) , discrmn)

colnames(discrmn) <- c("No.", "Est.", "S.E.",  "CI_lower",  "CI_upper")
save(discrmn, factor1, factor2, factor3, zuobiao_m1, zuobiao_m2, zuobiao_m3, 
     file = "output/result_irt_dropQ6.RData")

#####Plotting IRT estimates #######
rm(list=ls(all=TRUE)) 
load("output/result_irt_dropQ6.RData")

###
qcontent2 <- c(
  "People should not have universal suffrage if they have not been educated about democracy.",
  "Universality of human rights take precedence over sovereignty.",
  "When events that have major repercussions for the safety and security occur, the government should\n freely disseminate information even if information disclosure increases the risks of unrest.",
  "Western multiparty systems are unsuitable for China in its current state.",
  "Indiscriminately imitating (systems of) western-style freedom of speech will lead to\n social disorder in China.",
  "It is preferable to let universities recruit students by themselves than to have a unified national\n college entrance examination system.",
  "Religoius adherents should be allowed to conduct missionary  work in\n nonreligious spaces.",
  "Primary school, secondary school, and college students should all participate in government\n organized military training.",
  "National unity and territorial integrity are the highest interest of society.",
  "Even if procedural rules are violated in the process of investigation and evidence gathering, those\n who have actually committed crimes should be punished.",
  "The state has an obligation to provide foreign aid.",
  "It is acceptable to besmirch the images of national leaders and founding leaders in literary and\n artistic works.",
  "When laws fail to fully constrain criminal behaviors, people have the right to impose their own\n punishments for these behaviors.",
  "Media should be allowed to represent the voice of a particular social stratum or interest group.",
  "If it has sufficient state capabilities, China has the right to take any action to defend its\n national interests.",
  "Force should be used to reunify Taiwan with China if conditions permit.",
  "Lawyers should do their utmost to defend clients even if the client has committed a crime.",
  "Chinese citizens should be allowed to hold foreign citizenship.",
  "It is impossible for western countries led by the United States to tolerate the rise of China\n into a major power.",
  "The state should take measures to train and support athletes so they can win glory for the country in\n various international competitions.",
  "The minimum wage should be set by the state.",
  "The fruits of China's economic development since reform and opening up are enjoyed by a small\n group of people; most people have not received much benefit.",
  "In the decision-making of major (infrastructure) projects, individual interests should give way\n to social interests.",
  "Wasting food is an individual freedom.",
  "If the price of pork is too high, the government should intervene.",
  "A high tariff should be imposed on imported goods that are also produced domestically to\n protect domestic industries.",
  "Education should be public to the greatest extent.",
  "The interests of state-owned enterprises are part of the national interest.",
  "Attempting to control real estate prices will undermine economic development.",
  "The primary means to improve the lives of the low-income people is to give them fiscal\n subsidies and support.",
  "A rich person deserves better medical services.",
  "High income earners should disclose the sources of their income.",
  "People who make money through gains from financial investments contribute less to then society\n than people make money through labor.",
  "It is better to sell state-owned enterprises to capitalists than to let them go bankrupt.",
  "Sectors related to national security and important to the national economy and people's\n livelihoods must be controlled by state-owned enterprises.",
  "The process of capital accumulation is always accompanied by harm to the working class.",
  "Individuals should be able to own, buy and sell land.",
  "The government should adopt higher grain purchasing prices to boost the income of peasants.",
  "Foreign capital in China should enjoy the same treatment as national capital.",
  "Natural monopolies that emerge out of market competitions are harmless.",
  "Two adults should be free to engage in voluntary sexual behavior regardless of their marital status.",
  "One should not openly comment on the shortcomings of their elders.",
  "The modern Chinese society needs Confucianism.",
  "The fundamental standard to evaluate the value of a work of art is whether it is liked by the masses.",
  "Even with population pressures, the state and the society have no right to interfere in the decision\n to have a child, or how many children to have.",
  "The Eight Diagrams (Bagua) in The Book of Changes (Zhouyi) can explain many things well.",
  "The perspective of traditional Chinese medicine on human health is superior to that of modern\n mainstream medical science.",
  "It is unnecessary to push forward the simplification of Chinese characters.",
  "Traditional Chinese classics should be the basic education material for children.",
  "I will recognize the relationship between my child and a same-sex partner if it is a voluntary choice." 
)

#####
a1 <- length(factor1)
a2 <- length(factor2)
a3 <- length(factor3)

ft1_est <- discrmn[1:a1, ]
ft2_est <- discrmn[(a1+1):(a1+a2), ]
ft3_est <- discrmn[(a1+a2+1):49, ]

## plotting
ordered_discrmn <- rbind(ft1_est[order(ft1_est[,2], decreasing = TRUE),],
                         ft2_est[order(ft2_est[,2], decreasing = TRUE),],
                         ft3_est[order(ft3_est[,2], decreasing = TRUE),])


###hIRT versions of Figure 6 to 8###
####################################

pdf("graphs/irt_est_factor1_dropQ6.pdf",height = 9, width = 12)
par(mar = c(8,39,1,1), las = 1)
num <- 1:a1
plot(1, type = "n", xlim = c(-2.5, 2.5), ylim = c(a1,1),
     xlab = "", ylab = "", axes = FALSE, cex.axis = 1.5)
abline(h = 0:51, col = "gray90", cex = 0.8)
abline(v = seq(-2.5,2.5,0.5), col = "gray90", cex = 0.8)
abline(v = 0, col = "gray90", lwd = 5)
box(); axis(1, at = seq(-2.5, 2.5, 0.4))
for (i in num) {
  points(ordered_discrmn[i, 2], i,  pch =16, col = 1, cex = 1.2)
  lines(ordered_discrmn[i,4:5], c(i,i), col = 1, lwd = 4)
}
axis(2, at = 1:length(num), labels = qcontent2[ordered_discrmn[num,1]], cex.axis = 1)
mtext("Coefficient",1,2.5,cex = 1.5)
text(0.2, 1.5, "Latent Factor 1", cex = 2)
title(main = "IRT: Our Model", line = -41.5, cex.main = 1.5, adj = 1)
graphics.off()


pdf("graphs/irt_est_factor2_dropQ6.pdf",height = 12, width = 12)
par(mar = c(8,39,1,1), las = 1)
num <- (a1+1):(a1+a2)
plot(1, type = "n", xlim = c(-2.5, 2.5), ylim = c((a1+a2), (a1+1)),
     xlab = "", ylab = "", axes = FALSE, cex.axis = 1.5)
abline(h = 0:51, col = "gray90", cex = 0.8)
abline(v = seq(-2.5,2.5,0.1), col = "gray90", cex = 0.8)
abline(v = 0, col = "gray90", lwd = 5)
box(); axis(1, at = seq(-2.5, 2.5, 0.4))
for (i in num) { 
  points(ordered_discrmn[i, 2], i, col = 1, pch = 16, cex = 1.2)
  lines(ordered_discrmn[i,4:5], c(i,i), col = 1, pch = 16, lwd = 3)
}
axis(2, at = num, labels = qcontent2[ordered_discrmn[num,1]], cex.axis = 1)
mtext("Coefficient",1,2.5,cex = 1.5)
text(0.2, 38.5, "Latent Factor 2", cex = 2)
title(main = "IRT: Our Model", line = -57, cex.main = 1.5, adj = 1)
graphics.off()

pdf("graphs/irt_est_factor3_dropQ6.pdf",height = 4, width = 12)
par(mar = c(7,39,1,1), las = 1)
num <- (a1+a2+1):49
plot(1, type = "n", xlim = c(-2.5, 2.5), ylim = c(50.5, (a1+a2+0.5)),
     xlab = "", ylab = "", axes = FALSE, cex.axis = 1.5)
abline(h = 0:51, col = "gray90", cex = 0.8)
abline(v = seq(-2.5,2.5,0.1), col = "gray90", cex = 0.8)
abline(v = 0, col = "gray90", lwd = 5)
box(); axis(1, at = seq(-2.5, 2.5, 0.4))
for (i in num) { 
  points(ordered_discrmn[i, 2], i, col = 1, pch = 16, cex = 1.2)
  lines(ordered_discrmn[i,4:5], c(i,i), col = 1, pch = 16, lwd = 3)
}
axis(2, at = num, labels = qcontent2[ordered_discrmn[num,1]], cex.axis = 1)
mtext("Coefficient",1,2.5,cex = 1.5)
text(0.2, 49.5, "Latent Factor 3", cex = 2)
title(main = "IRT: Our Model", line = -17.5, cex.main = 1.5, adj = 1)
graphics.off()

